/*
 *  util.c
 *  scheme2
 *
 *  Created by Leo Katzenstein on 5/26/07.
 *  Copyright 2007 __MyCompanyName__. All rights reserved.
 *
 */

#include "scheme.h"

Pair *cons(Pair *car, Pair *cdr)
{
	Pair *p;
	p = new(Pair);
	p->car = car;
	p->cdr = cdr;
	return p;
}

Pair *make_num(long n)
{
	Pair *p;
	p = cons(FIXNUM, (Pair *) n);
	return p;
}

Pair *make_double(double d)
{
	double *q;
	q = new(double);
	*q = d;
	return cons(DOUBLE, (Pair *) q);
}

Pair *make_func(PF f)
{
	return cons(FUNC, (Pair *) f);
}

char *pname(Pair *sym)
{
	if (!is_symbol(sym))
		error("attempt to find the pname of a non symbol");
	for (sym = sym->cdr; sym; sym = sym->cdr)
	{
		if (sym->car->car == PNAME)
			return (char *) sym->car->cdr;
	}
	error("pname: PNAME not defined");
	return NULL; /* quiet the warning */
}

Pair *make_sym(char *pn)
{
	Pair *p, *q;

	/* return it if it already exists */
	for (p = sym_list; p; p = p->cdr)
	{
		if (!strcmp(pname(p->car), pn))
			return p->car;
	}

	/* ain't there, make it */
	/* create the pname property */
	p = cons( PNAME, (Pair *) strdup(pn) );

	/* create the single p-list entry */
	p = cons( p, NULL );

	/* create the symbol */
	p = cons( SYMBOL, p );

	/* push it onto the symbol list */
	q = cons( p, sym_list );
	sym_list = q;
	return p;
}

/*
 * Make a lambda binding
 * parameters are the lambda expression cdr and the env
 * ('lambda env args body)
 */
Pair *make_lambda(Pair *l, Pair *env)
{
	Pair *p;
	p = cons( env, l );
	p = cons( LAMBDA, p );
	return p;
}

/* sets the value in an environment */
Pair *setf(Pair *sym, Pair *val, Pair *env)
{
	Pair *p, *e;

	for (e = env; e; e = e->cdr)
	{
		for (p = e->car; p; p = p->cdr)
		{
			if (p->car->car == sym)
			{
				p->car->cdr = val;
				return val;
			}
		}
	}

	/* This may not be the right thing for free symbols */
	p = cons(cons(sym, val), env->car);
	env->car = p;
	return val;
}

/*
 * Create a list of pairs from the lists a and b,
 * the lists a and b must be the same length.
 */

Pair *pairlis(Pair *a, Pair *b)
{
	Pair head;
	Pair *tl;
	Pair *p, *q;

	head.cdr = NULL;
	tl = &head;

	while (a && b)
	{
		p = cons(a->car, b->car);  /* make the pair */
		q = cons(p, NULL);         /* append it */
		tl->cdr = q;
		tl = q;
		a = a->cdr;                      /* next */
		b = b->cdr;
	}
	if (a || b)
		error("pairlis: unequal list lengths");

	return head.cdr;
}
